home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Nov / di9811rs / SIZERF.PAS < prev   
Pascal/Delphi Source File  |  1998-05-28  |  16KB  |  476 lines
  1. unit SizerF;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, Menus;
  8.  
  9. type
  10.   TSizerForm = class(TForm)
  11.     ScrollBox1: TScrollBox;
  12.     imgInput: TImage;
  13.     grpCommands: TGroupBox;
  14.     cmdSmoothScale: TButton;
  15.     txtScale: TEdit;
  16.     Label2: TLabel;
  17.     txtAngle: TEdit;
  18.     Label1: TLabel;
  19.     cmdRotate: TButton;
  20.     sboxOutput: TScrollBox;
  21.     mnuMain: TMainMenu;
  22.     mnuFile: TMenuItem;
  23.     mnuOpen: TMenuItem;
  24.     mnuFileSep: TMenuItem;
  25.     mnuExit: TMenuItem;
  26.     dlgOpen: TOpenDialog;
  27.     Splitter1: TSplitter;
  28.     mnuSave: TMenuItem;
  29.     dlgSave: TSaveDialog;
  30.     cmdQuickScale: TButton;
  31.     procedure mnuExitClick(Sender: TObject);
  32.     procedure mnuOpenClick(Sender: TObject);
  33.     procedure mnuSaveClick(Sender: TObject);
  34.     procedure cmdRotateClick(Sender: TObject);
  35.     procedure cmdQuickScaleClick(Sender: TObject);
  36.     procedure cmdSmoothScaleClick(Sender: TObject);
  37.     procedure SeparateColor(color : TColor;
  38.         var red, green, blue : Integer);
  39.     function RGB(red, green, blue : Integer) : TColor;
  40.     procedure EnlargePicture(
  41.         from_canvas, to_canvas : TCanvas;
  42.         from_x1, from_y1, from_x2, from_y2 : Integer;
  43.         to_x1, to_y1, to_x2, to_y2 : Integer);
  44.     procedure ShrinkPicture(
  45.         from_canvas, to_canvas : TCanvas;
  46.         from_x1, from_y1, from_x2, from_y2 : Integer;
  47.         to_x1, to_y1, to_x2, to_y2 : Integer);
  48.     procedure RotatePicture(
  49.         from_canvas, to_canvas : TCanvas;
  50.         theta : Single;
  51.         from_x1, from_y1, from_x2, from_y2 : Integer;
  52.         to_x1, to_y1, to_x2, to_y2 : Integer);
  53.     procedure GetRotatedSize(
  54.         theta : Single;
  55.         old_width, old_height : Integer;
  56.         var new_width, new_height : Integer);
  57.   private
  58.     { Private declarations }
  59.     imgOutput : TImage;
  60.  
  61.   public
  62.     { Public declarations }
  63.   end;
  64.  
  65. var
  66.   SizerForm: TSizerForm;
  67.  
  68. implementation
  69.  
  70. {$R *.DFM}
  71.  
  72.  
  73. procedure TSizerForm.mnuExitClick(Sender: TObject);
  74. begin
  75.     Close;
  76. end;
  77.  
  78. procedure TSizerForm.mnuOpenClick(Sender: TObject);
  79. begin
  80.     // Show the file open dialog. Exit if the user cancels.
  81.     if (not dlgOpen.Execute) then Exit;
  82.  
  83.     // Load the input picture.
  84.     imgInput.Picture.LoadFromFile(dlgOpen.FileName);
  85.  
  86.     // Destroy the output picture.
  87.     imgOutput.Free;
  88.     imgOutput := nil;
  89.  
  90.     // Disable the Save menu command.
  91.     mnuSave.Enabled := False;
  92.  
  93.     // Enable the Quick Scale, Scale and Rotate buttons.
  94.     cmdQuickScale.Enabled := True;
  95.     cmdSmoothScale.Enabled := True;
  96.     cmdRotate.Enabled := True;
  97. end;
  98.  
  99. procedure TSizerForm.mnuSaveClick(Sender: TObject);
  100. begin
  101.     // Show the file save dialog. Exit if the user cancels.
  102.     if (not dlgSave.Execute) then Exit;
  103.  
  104.     // Display the hourglass cursor.
  105.     Screen.Cursor := crHourGlass;
  106.     Refresh;
  107.  
  108.     // Save the output picture.
  109.     imgOutput.Picture.SaveToFile(dlgSave.FileName);
  110.  
  111.     // Restore the cursor.
  112.     Screen.Cursor := crDefault;
  113. end;
  114.  
  115. procedure TSizerForm.cmdRotateClick(Sender: TObject);
  116. var
  117.     theta                 : Single;
  118.     new_width, new_height : Integer;
  119. begin
  120.     // Display the hourglass cursor.
  121.     Screen.Cursor := crHourGlass;
  122.  
  123.     // Get the angle of rotation in radians.
  124.     theta := Pi * StrToFloat(txtAngle.Text) / 180.0;
  125.  
  126.     // Destroy the old output picture.
  127.     imgOutput.Free;
  128.  
  129.     // Create the output image.
  130.     imgOutput := TImage.Create(sboxOutput);
  131.     imgOutput.Parent := sboxOutput;
  132.  
  133.     // Resize the output image.
  134.     GetRotatedSize(theta,
  135.         imgInput.ClientWidth, imgInput.ClientHeight,
  136.         new_width, new_height);
  137.     imgOutput.Width  := new_width;
  138.     imgOutput.Height := new_height;
  139.  
  140.     // Rotate the image
  141.     RotatePicture(imgInput.Canvas, imgOutput.Canvas,
  142.         theta,
  143.         0, 0,
  144.         imgInput.ClientWidth - 1, imgInput.ClientHeight - 1,
  145.         0, 0, new_width - 1, new_height - 1);
  146.  
  147.     // Restore the cursor.
  148.     Screen.Cursor := crDefault;
  149.  
  150.     // Enable the Save menu command.
  151.     mnuSave.Enabled := True;
  152. end;
  153.  
  154. procedure TSizerForm.cmdQuickScaleClick(Sender: TObject);
  155. var
  156.     scale                 : Single;
  157.     new_width, new_height : Integer;
  158. begin
  159.     // Get the scale factor.
  160.     scale := StrToFloat(txtScale.Text);
  161.  
  162.     // Destroy the old output picture.
  163.     imgOutput.Free;
  164.  
  165.     // Create the output image.
  166.     imgOutput := TImage.Create(sboxOutput);
  167.     imgOutput.Parent := sboxOutput;
  168.  
  169.     // Resize the output image.
  170.     new_width := Round(imgInput.Width * scale);
  171.     new_height := Round(imgInput.Height * scale);
  172.     imgOutput.Width := new_width;
  173.     imgOutput.Height := new_height;
  174.  
  175.     // Use StretchDraw to copy the image.
  176.     imgOutput.Canvas.StretchDraw(imgOutput.ClientRect,
  177.         imgInput.Picture.Graphic);
  178.  
  179.     // Enable the Save menu command.
  180.     mnuSave.Enabled := True;
  181. end;
  182.  
  183. procedure TSizerForm.cmdSmoothScaleClick(Sender: TObject);
  184. var
  185.     scale                 : Single;
  186.     new_width, new_height : Integer;
  187. begin
  188.     // Display the hourglass cursor.
  189.     Screen.Cursor := crHourGlass;
  190.     Refresh;
  191.  
  192.     // Get the scale factor.
  193.     scale := StrToFloat(txtScale.Text);
  194.  
  195.     // Destroy the old output picture.
  196.     imgOutput.Free;
  197.  
  198.     // Create the output image.
  199.     imgOutput := TImage.Create(sboxOutput);
  200.     imgOutput.Parent := sboxOutput;
  201.  
  202.     // Resize the output image.
  203.     new_width := Round(imgInput.Width * scale);
  204.     new_height := Round(imgInput.Height * scale);
  205.     imgOutput.Width := new_width;
  206.     imgOutput.Height := new_height;
  207.  
  208.     // Resize using ShrinkPicture or EnlargePicture.
  209.     if (scale > 1.0) then
  210.         EnlargePicture(imgInput.Canvas, imgOutput.Canvas,
  211.             0, 0,
  212.             imgInput.ClientWidth - 1, imgInput.ClientHeight - 1,
  213.             0, 0, new_width - 1, new_height - 1)
  214.     else
  215.         ShrinkPicture(imgInput.Canvas, imgOutput.Canvas,
  216.             0, 0,
  217.             imgInput.ClientWidth - 1, imgInput.ClientHeight - 1,
  218.             0, 0, new_width - 1, new_height - 1);
  219.  
  220.     // Restore the cursor.
  221.     Screen.Cursor := crDefault;
  222.  
  223.     // Enable the Save menu command.
  224.     mnuSave.Enabled := True;
  225. end;
  226.  
  227. // Separate a color into red, green, and blue components.
  228. procedure TSizerForm.SeparateColor(color : TColor;
  229.     var red, green, blue : Integer);
  230. begin
  231.     red   :=  color mod 256;
  232.     green := (color div 256) mod 256;
  233.     blue  :=  color div 65536;
  234. end;
  235.  
  236. // Combine red, green, and blue color components.
  237. function TSizerForm.RGB(red, green, blue : Integer) : TColor;
  238. begin
  239.     Result := red + 256 * (green + 256 * blue);
  240. end;
  241.  
  242. // Enlarge the picture in from_canvas and place it
  243. // in to_canvas.
  244. procedure TSizerForm.EnlargePicture(
  245.     from_canvas, to_canvas : TCanvas;
  246.     from_x1, from_y1, from_x2, from_y2 : Integer;
  247.     to_x1, to_y1, to_x2, to_y2 : Integer);
  248. var
  249.     xscale, yscale         : Single;
  250.     sfrom_y, sfrom_x       : Single;
  251.     ifrom_y, ifrom_x       : Integer;
  252.     to_y, to_x             : Integer;
  253.     weight_x, weight_y     : array[0..1] of Single;
  254.     weight                 : Single;
  255.     new_red, new_green     : Integer;
  256.     new_blue               : Integer;
  257.     total_red, total_green : Single;
  258.     total_blue             : Single;
  259.     ix, iy                 : Integer;
  260. begin
  261.     // Compute the scaling parameters. This is useful if
  262.     // the image is not being scaled proportionally.
  263.     xscale := (to_x2 - to_x1 + 1) / (from_x2 - from_x1);
  264.     yscale := (to_y2 - to_y1 + 1) / (from_y2 - from_y1);
  265.  
  266.     // Perform the enlargement.
  267.     for to_y := to_y1 to to_y2 do
  268.     begin
  269.         sfrom_y := (to_y - to_y1) / yscale + from_y1;
  270.         ifrom_y := Trunc(sfrom_y);
  271.         weight_y[1] := sfrom_y - ifrom_y;
  272.         weight_y[0] := 1 - weight_y[1];
  273.         for to_x := to_x1 to to_x2 do
  274.         begin
  275.             sfrom_x := (to_x - to_x1) / xscale + from_x1;
  276.             ifrom_x := Trunc(sfrom_x);
  277.             weight_x[1] := sfrom_x - ifrom_x;
  278.             weight_x[0] := 1 - weight_x[1];
  279.  
  280.             // Average the color